home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / MEDICAL / 2608A.ZIP / GP.ZIP / RECALLS.SRC < prev    next >
Text File  |  1990-11-03  |  18KB  |  549 lines
  1. ;\|
  2. ;RECALLS.SRC     Translated from RECALLS.EDT by Roger Mathew's EDT2SRC Ver 4.11
  3. ;START    01:59:01 PM   9/ 4/90   |
  4. RECALLSX:
  5.     define(Z30|A|30||)
  6.     define(YES.NO|A|1||)
  7.     define(NUM_N|N|2||)
  8.     define(NUM|A|2||)
  9.     define(DATE_A|A|8||)
  10.     define(DATE_B|A|10||)
  11.     define(TO_DATE|S|8||)
  12.     define(SENT_DATE|S|8||)
  13.     define(CHK_DATE|S|8||)
  14.     define(PUNC2|N|2||)
  15.     define(CH_NAME|A|15||)
  16.     define(HIS|A|3||)
  17.     define(CLIN_DAY|A|25||)
  18.     define(CLIN_TIME|A|10||)
  19.     define(CNTR|N|2||)
  20.     define(FLAG|A|1||)
  21.     define(AMOUNTX|N|4||)
  22.     define(S10|A|10||)
  23.     define(DATECOD|S|8||)
  24.     define(CODER|A|5||)
  25.     define(C30|A|30||)
  26.     define(TM|A|27||4)
  27.     define(A30|A|30||)
  28.     define(CHOICE|N|1||)
  29.     define(TDND|S|8||)
  30.     define(DATERP|S|8||)
  31.     define(B30|A|30||)
  32.     define(S1|A|1||)
  33.     define(TD|S|8||)
  34.     define(A8|A|8||)
  35.     define(B8|A|8||)
  36.     define(YES.NO|A|1||)
  37.     define(N5|N|5||)
  38.     define(D1|A|1||)
  39.     define(NY|A|1||)
  40.     define(CODEX1|S|8||)
  41.     define(CTR|N|2||)
  42.     define(DATEN|N|2||)
  43.     define(DATEX|S|8||)
  44.     define(ARRAY1|A|30||3)
  45.     define(ARRAY2|A|22||3)
  46.     define(ARRAY3|A|22||3)
  47.     define(ARRAY4|A|4||3)
  48.     define(ARRAY5|S|8||3)
  49.     define(TIT|A|4||)
  50.     define(PATIENT1A|A|30||)
  51.     define(PUNC1|N|2||)
  52.     define(N.2.0.P|N|2||)
  53.     define(P.2.0.1|N|2||)
  54.     define(P.2.0.2|N|2||)
  55.     define(PATIENT2|A|30||)
  56.     define(P.2.0.3|N|2||)
  57.     define(RECTYPE1|A|4||)
  58.     define(RECTYPE2|A|4||)
  59.     define(PATIENT1|A|30||)
  60.     define(DOB1|D|10||)
  61.     define(DOB2|D|10||)
  62. STARTREC:
  63.     mount(NOTE|S)
  64.     pmsg(""|1|1|Y|N|S|)
  65.     open(PATIENT||0|FILE_LOCK)
  66.     open(GPSETUP||0|)
  67.     open(RECALLS||0|FILE_LOCK)
  68.     D1 = ("")
  69.     date(TD|G)
  70.     YES.NO = ("")
  71.     DATEX = (0)
  72.     CODEX1 = (0)
  73.     NY = ("")
  74.     trap(I|G|PRINTSTOP)
  75.     trap(S|I)
  76.     trap(D|I)
  77.     trap(F|I)
  78.     trap(R|I)
  79.     trap(B|I)
  80.     trap(G|I)
  81.     trap(H|S|HELP)
  82.     trap(M|I)
  83.     trap(N|I)
  84.     trap(Q|G|MENU)
  85.     trap(J|G|LASTSEEN)
  86.     mount(RECALLS|S)
  87.     enter(RECTYPE1||||Y|Y|N|||N)
  88.     enter(RECTYPE2||||Y|Y|N|||N)
  89.     enter(CTR|"123456789"|||N|Y|N|||N)
  90.     enter(CODEX1|||RECALLSX|N|Y|N|||N)
  91. DATEXX:
  92.     NY = ("")
  93.     enter(YES.NO|"YN"|||Y|Y|N|||N)
  94. CODEX1:
  95.     gosub MOUNTRECAL
  96. RECSTART:
  97.     COD.PAT.NAME = ("A")
  98.     find(G|COD.PAT.NAME|EXIT|N)
  99. RECTEST:
  100.     if COD[CTR] = ("HYS") goto NEXTRECALL
  101.     if COD[CTR] = ("VIR") goto NEXTRECALL
  102.     if COD[CTR] = ("REF") goto NEXTRECALL
  103.     if COD[CTR] = ("MOV") goto NEXTRECALL
  104.     if RECTYPE1 <> ("") then if RECTYPE1 > (COD[CTR]) goto NEXTRECALL
  105.     if RECTYPE2 <> ("") then if RECTYPE2 < (COD[CTR]) goto NEXTRECALL
  106.     if COD.D[CTR] > (CODEX1) goto NEXTRECALL
  107.     if COD.D[CTR] = (0) goto NEXTRECALL
  108.     RECORD.NUMBER = (COD.REF)
  109.     DATECOD = (COD.D[CTR])
  110.     CODER = (COD[CTR])
  111.     find(M|RECORD.NUMBER|EXIT|)
  112.     DATERP = (COD.D[CTR])
  113.     if NY = ("") do
  114.         {
  115.         gosub PRINTRECAL
  116.         }
  117.     else
  118.         {
  119.         gosub RECLABPRIN
  120.         }
  121. NEXTRECALL:
  122.     find(N|RECALLS|EXITX|)
  123.     goto RECTEST
  124. MOUNTRECAL:
  125.     mount(RPLABELS|R|P)
  126.     pchr(P|10)
  127.     pchr(P|11)
  128.     pchr(P|4)
  129.     pchr(P|1)
  130.     pset(132|66|60)
  131.     trap(I|G|PRINTSTOP)
  132.     trap(P|S|RECHEAD)
  133.     AMOUNTX = (0)
  134.     gosub RECHEAD
  135.     ret
  136. PRINTRECAL:
  137.     pfmt(18|||N|N|)
  138.     AMOUNTX = (AMOUNTX+1)
  139.     DATECOD = (0)
  140.     CODER = ("")
  141.     ret
  142. RECHEAD:
  143.     pfmt(16|||N|N|)
  144.     pfmt(17|||N|N|)
  145.     ret
  146. RECALLS:
  147.     trap(P|D)
  148.     ptof
  149.     if D1 = ("X") then goto RECALLSX
  150.     if YES.NO = ("Y") do
  151.         {
  152.         gosub RECLABS
  153.         }
  154.     else
  155.         {
  156.         goto RECALLSX
  157.         }
  158.     goto RECSTART
  159. TOPOF:
  160.     ptof
  161.     ret
  162. RECLABS:
  163.     NY = ("X")
  164.     trap(P|D)
  165.     trap(I|S|PRINTSTOP)
  166.     pchr(P|10)
  167.     pchr(P|12)
  168.     pchr(P|4)
  169.     mount(RPLABELS|R|P)
  170.     pset(130|8|8)
  171.     pchr(P|1)
  172.     D1 = ("X")
  173.     ret
  174. PRINT_LAB:
  175.     pfmt(1|||N|N|)
  176.     pblnk(1)
  177.     pfmt(2|||N|N|)
  178.     pblnk(1)
  179.     pfmt(3|||N|N|)
  180.     pblnk(1)
  181.     pfmt(5|||N|N|)
  182.     pblnk(1)
  183.     CNTR = (0)
  184.     if FLAG = ("X") goto EXIT
  185.     gosub CL_ARRAY
  186.     ret
  187. CL_ARRAY:
  188.     clrmem(ARRAY1|3)
  189.     clrmem(ARRAY2|3)
  190.     clrmem(ARRAY3|3)
  191.     clrmem(ARRAY4|3)
  192.     clrmem(ARRAY5|3)
  193.     ret
  194. RECLABPRIN:
  195.     gosub SEXIST
  196.     gosub NEWX
  197.     NY = ("X")
  198.     DATECOD = (0)
  199.     CODER = ("")
  200.     CNTR = (CNTR+1)
  201.     ARRAY1[CNTR] = (Z30)
  202.     ARRAY2[CNTR] = (ADDRESS1)
  203.     ARRAY3[CNTR] = (AREA)
  204.     ARRAY4[CNTR] = (COD[CTR])
  205.     ARRAY5[CNTR] = (COD.D[CTR])
  206.     if CNTR = (3) gosub PRINT_LAB
  207.     ret
  208. EXITX:
  209.     if NY <> ("") do
  210.         {
  211.         FLAG = ("X")
  212.         gosub PRINT_LAB
  213.         }
  214.     goto RECALLS
  215. REPONLY:
  216.     run("REPONLY")
  217. SEXIST:
  218.     if SEX = ("M") then TIT = ("Mr.")
  219.     if SEX = ("F") do
  220.         {
  221.         if MARITAL.STATUS = ("M") do
  222.             {
  223.             TIT = ("Mrs.")
  224.             }
  225.         else
  226.             {
  227.             TIT = ("Ms.")
  228.             }
  229.         }
  230.     if SEX = ("") then TIT = ("Ms.")
  231.     trim(TIT|T)
  232.     ret
  233. NEWX:
  234.     NY = (" ")
  235.     PATIENT1A = (PATIENT.NAME)
  236.     trim(PATIENT1A|T)
  237.     PUNC1 =loc(","|PATIENT1A|1||27)
  238.     N.2.0.P =siz(A|PATIENT.NAME)
  239.     P.2.0.1 = (PUNC1-1)
  240.     PATIENT2 =mid(PATIENT.NAME|1|P.2.0.1|)
  241.     P.2.0.2 = (PUNC1+2)
  242.     P.2.0.3 = (N.2.0.P-P.2.0.2+1)
  243.     PATIENT1 =mid(PATIENT1A|P.2.0.2|P.2.0.3|)
  244.     trim(PATIENT1|T)
  245.     trim(PATIENT2|T)
  246.     Z30 = (TIT+PATIENT1+NY+PATIENT2)
  247.     ret
  248. CLEARALL:
  249.     clr(PATIENT|B)
  250.     clr(RECALLS|B)
  251.     S1 = ("")
  252.     DATEX = (0)
  253.     YES.NO = ("")
  254.     ret
  255. EXIT:
  256.     run("recmenu")
  257. EXIT1:
  258.     run("recmenu")
  259. PRINTSTOP:
  260.     pon(S)
  261.     clrlne(1|25)
  262.     pmsg("CONTINUE ? (Y/N):"|30|12|N|N|S|)
  263.     enter(YES.NO|"YN"||PRINTSTOP|Y|Y|N|48|12|N)
  264.     if YES.NO <> ("Y") then run("recmenu")
  265.     pon(P)
  266.     ret
  267. MENU:
  268.     TM[1] = (" 1 - EXIT             01011")
  269.     menu(1|20|2|23|0|TM|CHOICE|1|22|MENU||"-------RECALLS--------"|N)
  270.     on(CHOICE|G|EXIT1|MENU)
  271. TRACE:
  272.     break
  273.     ret
  274. FILE_LOCK:
  275.     pmsg("FILE PATIENT AND/OR RECALLS IS IN USE - EXIT"|20|24|Y|N|S|)
  276.     clrlne(1|24)
  277.     run("recmenu")
  278. HELP:
  279.     saves(1)
  280.     window(1|23|22|78)
  281.     pmsg("                                    SMEAR RECALLS"|1|1|N|Y|S|)
  282.     pmsg("                                    ============="|1|2|N|Y|S|)
  283.     pmsg("1.USE UPDATE PROGRAM AND MAKE SURE ALL WOMEN BETWEEN 33 AND 65 ARE ENTERED"|1|3|N|Y|S|)
  284.     pmsg("2.ALL THESE WOMEN MUST HAVE A RECALL DATE."|1|4|N|Y|S|)
  285.     pmsg("3.RUN REPORT ONLY TO GET LATEST UPDATE ON TOTAL AT-RISK GROUP"|1|5|N|Y|S|)
  286.     pmsg("4.RECALL EVERY MONTH ON THE 16th + A DAY OR TWO"|1|6|N|Y||)
  287.     pmsg("5.CHECK OFF AGAINST RECALL LIST. ALL NON-ATTENDERS WILL BE ASKED AGAIN"|1|7|N|Y|S|)
  288.     pmsg("6.NON-ATTENDERS WILL BE THOSE WHO ARE MORE THAN ONE MONTH BEHIND"|1|8|N|Y||)
  289.     pmsg(""|1|9|N|Y|S|)
  290.     pmsg("                                    CODES"|1|10|N|Y|S|)
  291.     pmsg("                                    ====="|1|11|N|Y|S|)
  292.     pmsg("CODE 1 = SMEARS"|1|12|N|Y|S|)
  293.     pmsg("CODE 2 = CONTRACEPTION"|1|13|N|Y|S|)
  294.     pmsg("CODE 3 = IMMUNISATION"|1|14|N|Y|S|)
  295.     pmsg("CODE 4 = DIABETES"|1|15|N|Y|S|)
  296.     pmsg("CODE 5 = EPILEPSY"|1|16|N|Y|S|)
  297.     pmsg("CODE 6 = THYROID"|1|17|N|Y|S|)
  298.     pmsg("CODE 7 = ANGINA AND HEART DISEASE"|1|18|N|Y|S|)
  299.     pmsg("CODE 8 = ASTHMA"|1|19|N|Y|S|)
  300.     pmsg("CODE 9 = BP"|1|20|N|Y|S|)
  301.     pmsg(""|1|21|Y|N|S|)
  302.     redsp(1)
  303.     ret
  304. LASTSEEN:
  305.     trap(I|S|PRINTSTOP)
  306.     trap(J|G|STARTREC)
  307.     mount(LABS|S)
  308.     enter(TO_DATE||||N|Y|N|||N)
  309.     DOB1 = (TO_DATE)
  310.     DOB2 = (TO_DATE)
  311.     DATE_A = (""+TO_DATE)
  312.     NUM =mid(DATE_A|7|2|)
  313.     NUM_N = (NUM)
  314.     NUM_N = (NUM_N-3)
  315.     NUM = (NUM_N)
  316.     mid(DATE_A|7|2|NUM|)
  317.     CHK_DATE = (DATE_A)
  318.     SENT_DATE = (TO_DATE)
  319.     DATE_B = (""+DOB1)
  320.     NUM =mid(DATE_B|9|2|)
  321.     NUM_N = (NUM)
  322.     NUM_N = (NUM_N-75)
  323.     NUM = (NUM_N)
  324.     mid(DATE_B|9|2|NUM|)
  325.     DOB1 = (DATE_B)
  326.     DATE_B = (""+DOB2)
  327.     NUM =mid(DATE_B|9|2|)
  328.     NUM_N = (NUM)
  329.     NUM_N = (NUM_N-16)
  330.     NUM = (NUM_N)
  331.     mid(DATE_B|9|2|NUM|)
  332.     DOB2 = (DATE_B)
  333.     enter(YES.NO|"YN"|||Y|Y|N|||N)
  334.     if YES.NO <> ("Y") goto LASTSEEN
  335.     gosub RECLABS
  336.     find(B|PATIENT.NAME|EXIT|)
  337.     goto DAT_TEST
  338. TEST_SEEN:
  339.     if DATE_SEEN > (SEEN) do
  340.         {
  341.         SEEN = (DATE_SEEN)
  342.         save(PATIENT|N|N)
  343.         find(M|PATIENT.NAME||)
  344.         }
  345.     if SEEN < (CHK_DATE) do
  346.         {
  347.         if SENT_FOR > (TO_DATE-365) goto NEXT_SEEN
  348.         gosub PRINT_SEEN
  349.         SENT_FOR = (SENT_DATE)
  350.         save(PATIENT|N|N)
  351.         find(M|PATIENT.NAME||)
  352.         }
  353. NEXT_SEEN:
  354.     find(N|PATIENT|EXIT_PRINT|)
  355.     pmsg(RECORD.NUMBER|1|1|N|N|S|)
  356.     goto DAT_TEST
  357.     goto TEST_SEEN
  358. PRINT_SEEN:
  359.     gosub SEXIST
  360.     gosub NEWX
  361.     CNTR = (CNTR+1)
  362.     ARRAY1[CNTR] = (Z30)
  363.     ARRAY2[CNTR] = (ADDRESS1)
  364.     ARRAY3[CNTR] = (AREA)
  365.     ARRAY4[CNTR] = ("")
  366.     ARRAY5[CNTR] = ("")
  367.     if CNTR = (3) gosub SEEN_PRINT
  368.     ret
  369. SEEN_PRINT:
  370.     pfmt(1|||N|N|)
  371.     pblnk(1)
  372.     pfmt(2|||N|N|)
  373.     pblnk(1)
  374.     pfmt(3|||N|N|)
  375.     pblnk(3)
  376.     CNTR = (0)
  377.     gosub CL_ARRAY
  378.     ret
  379. EXIT_PRINT:
  380.     gosub SEEN_PRINT
  381.     goto EXIT
  382. DAT_TEST:
  383.     if DATE.OF.BIRTH < (DOB1) goto NEXT_SEEN
  384.     if DATE.OF.BIRTH > (DOB2) goto NEXT_SEEN
  385.     goto TEST_SEEN
  386. \R RPLABELS
  387. &                                      &                                        &
  388. &                                      &                                        &
  389. &                                      &                                        &
  390.  
  391. &    &                                 &    &                                   &    &
  392.  
  393.  
  394.  
  395.  
  396.  
  397.  
  398.       &
  399.            &
  400.               &
  401.       &
  402. PATIENT                - RECALL REPORT- &                                        CODE (& )
  403. ------------------------------------------------------------------------------------------
  404. &                             &                     &                      (&    )&         &     [&]
  405.  
  406.  
  407.  
  408.  
  409.  
  410.  
  411.  
  412.  
  413.  
  414.  
  415.  
  416.  
  417.  
  418.  
  419.  
  420.  
  421.  
  422.  
  423.  
  424.  
  425.  
  426.  
  427.  
  428.  
  429.  
  430.  
  431.  
  432.  
  433.  
  434.  
  435. \
  436. ARRAY1[1]
  437. ARRAY1[2]
  438. ARRAY1[3]
  439. ARRAY2[1]
  440. ARRAY2[2]
  441. ARRAY2[3]
  442. ARRAY3[1]
  443. ARRAY3[2]
  444. ARRAY3[3]
  445. ARRAY4[1]
  446. ARRAY5[1]
  447. ARRAY4[2]
  448. ARRAY5[2]
  449. ARRAY4[3]
  450. ARRAY5[3]
  451. Z30
  452. ADDRESS1
  453. AREA
  454. DATERP
  455. TD
  456. CTR
  457. PATIENT.NAME
  458. ADDRESS1
  459. AREA
  460. CODER
  461. DATECOD
  462. AMOUNTX
  463. DOCTOR
  464. \
  465. \SSRECALLS 
  466.                                                                                                 
  467.                                                                                                 
  468.                                                                                                 
  469.                                                   YOU MAY JUMP TO PRINT "NOT SEEN" LABELS       
  470.                                                                                                 
  471.       This will recall all recall code 1 except "HYS;VIR;MOV;REF;ETC"                           
  472.                                                                                                 
  473.    RECALLS                                                       ╔══════════════════════════════
  474. ══════════╗                                      ║                                        ║     
  475.                                  ║  From Code: t t t t  to  Code: t t t t         ║                     
  476.                  ║                                        ║                                     
  477.  ║ Recall code:[ t t]                       ║                                      ║              
  478.                           ║                                      ║ Up to Date: t t t t t t t t          
  479. Labels?: t ║                                      ╚════════════════════════════════════════╝     
  480.                                F1 - Help   "Printer on for labels" Esc - Exit                   
  481.                                                                                                 
  482.                                                                                                 
  483.                                                                                                 
  484.                                                                                                 
  485.                                                                                                 
  486. \
  487. RECTYPE1            4 A 3112
  488. RECTYPE2            4 A 4612
  489. CTR                 2 N 3314
  490. CODEX1              8 S 3116
  491. YES.NO              1 A 5716
  492. \
  493. \STNOTE    
  494.                          RECALLS - WHAT TO DO
  495.                          ====================
  496.  
  497. 1. TO TAG ALL POTENTIAL RECALLS ANSWER RUN RECALLS AT RISK FROM MAIN MENU.
  498.  
  499.   (THIS WILL TAG A GIVEN AGE GROUP WITH CODE <****>)
  500.  
  501. 2. TO UPDATE THE <****> USE EASY SMEAR /IMMUNISATION UPDATE PROGRAM.
  502.  
  503. 3. IF YOU ANSWER NO TO REPORT ONLY YOU WILL PRINT A LIST OF OUTSTANDING
  504.    RECALLS WITH OR WITHOUT LABELS.
  505.  
  506. 6. PRINT OUT THESE AND SEND TO PATIENTS.
  507.  
  508. 7. UPDATE  RESULTS USING EASY RECALL MAINTENANCE
  509.  
  510.         NOTE: THIS PROGRAM WILL ALWAYS PRINT OUT "ALL" OUTSTANDING RECALLS.
  511.  
  512.                           ========================
  513.  
  514.  
  515.  
  516.  
  517.  
  518. \
  519. \
  520. \SSLABS    
  521.                                                                                                 
  522.                                                                                                 
  523.                                                                                                 
  524.                                                                                                 
  525.                                                                                                 
  526.                      PRINTS LABELS FOR 3 YEAR RECALL REQUEST                                    
  527.                                                                                      ENTER FPC T
  528. ARGET DATE:  t t t t t t t t EG 01/04/91                                     CHECKS FROM          :  t t t t
  529.  t t t t                                                                         t t t t t t t t t t          
  530.                                               CONTINUE: t     t t t t t t t t t t                          
  531.                                                                                                 
  532.        REQUIRES 3 ABREAST LABELS IN PRINTER                                                     
  533.                                                                                                 
  534.                                                                                                 
  535.                                                                                                 
  536.                                                                                                 
  537.                                                                                                 
  538.                                                                                                 
  539.                                                                                                 
  540.                                                                                                 
  541. \
  542. TO_DATE             8 S 45 9
  543. CHK_DATE            8 S 4510
  544. DOB1               10 D 4511
  545. YES.NO              1 A 4012
  546. DOB2               10 D 4512
  547. \
  548.  
  549.